perm filename ALGOL.SAI[PUB,TES]1 blob
sn#129292 filedate 1974-11-03 generic text, type T, neo UTF8
00100 BEGOF("ALGOL")
00200
00300 COMMENT
00400
00500 The ALGOL (SAIL) subset of PUB -- statements, conditionals, and
00600 expressions.
00700
00800 The statement parser is recursive descent. Its top-level production
00900 is MANUSCRIPT. A manuscript is a sequence of CHUNKs, including
01000 ASSIGNMENTs, LABELDEFinitions, COMMANDs, PROCedureSTATEMENTs, and
01100 TEXTLINEs.
01200
01300 The expression parser is iterative descent. Its top-level production
01400 is E. An E is a conditional expression, an assignment expression, or
01500 a simple expression.
01600
01700 ;
01800
01900 PROCEDURES
00100 PUBLIC SIMPLE PROCEDURE ALGOL! ;$"#
00200 BEGIN "ALGOL!"
00300 ON ← TRUE ; COMMENT TO EXECUTE PARSED CODE ;
00400 LIT!ENTITY ← LIT!TRAIL ← NULL ;
00500 EMPTYTHIS ; EMPTYTHAT ;
00600 END "ALGOL!" ;
00100 PUBLIC RECURSIVE BOOLEAN PROCEDURE CHUNK(BOOLEAN VALID) ;$"#
00200 BEGIN
00300 IF PAGEMARKS > PAGEWAS THEN
00400 BEGIN comment, might be AT PAGEMARK response ;
00500 FOR PAGEWAS ← PAGEWAS + 1 THRU PAGEMARKS DO IF SIGNALD[FF] THEN RESPOND(SIGNALD[FF]) ;
00600 PAGEWAS ← PAGEMARKS ;
00700 END ;
00800 RETURN(THISISID AND (ASSIGNMENT OR LABELDEF OR COMMAND OR PROCSTATEMENT)
00900 OR TEXTLINE OR EMPTYCHUNK OR NONSENSE(VALID)) ;
01000 TES ADDED PROCSTATEMENT 8/20/74 ;
01100 END "CHUNK" ;
00100 PUBLIC RECURSIVE PROCEDURE DCONDITIONAL ;$"#
00200 BEGIN
00300 BOOLEAN WASON ;
00400 WASON ← ON ; PASS ; ON ← TRUESTR(E(NULL,"THEN")) AND WASON ;
00500 IF ITS(THEN) THEN PASS ELSE WARN("=","Missed THEN in conditional statement") ;
00600 IF STATEMENT THEN BEGIN ON←TRUE; RETURN END; TES 8/14/74 DONE FROM REPEAT ;
00700 IF ITS(ELSE) THEN BEGIN ON←WASON AND NOT ON; PASS ; IF STATEMENT THEN BEGIN ON←TRUE; RETURN END END ;
00800 ON ← WASON ;
00900 END "DCONDITIONAL" ;
00100 PUBLIC RECURSIVE STRING PROCEDURE E(STRING DEFAULT, STOPWORD) ;$"#
00200 COMMENT Scan a SAIL-Like <Expression>. First check trivial case. ;
00300 IF ITS(IF) THEN
00400 BEGIN "CONDITIONAL EXPRESSION"
00500 STRING BOOLX, THENX, ELSEX ; BOOLEAN WASON ;
00600 WASON ← ON ; PASS ;
00700 BOOLX ← E(NULL, "THEN") ; ON ← WASON AND TRUESTR(BOOLX) ;
00800 IF ITS(THEN) THEN PASS ELSE WARN("=","Missed THEN in conditional expression "&THISWD) ;
00900 THENX ← E(NULL, "ELSE") ;
01000 IF ITS(ELSE) THEN
01100 BEGIN
01200 ON ← WASON AND FALSTR(BOOLX) ; PASS ;
01300 ELSEX ← E(NULL, STOPWORD) ;
01400 END
01500 ELSE ELSEX ← NULL ;
01600 ON ← WASON ;
01700 RETURN(IF TRUESTR(BOOLX) THEN THENX ELSE ELSEX) ;
01800 END "CONDITIONAL EXPRESSION"
01900 ELSE IF THISTYPE = -TERQ OR THISTYPE = CMDTYPE OR ITSV(STOPWORD) THEN
02000 RETURN(DEFAULT) comment omitted expression ;
02100 ELSE IF THISTYPE GEQ -1 AND (THATTYPE = -TERQ OR THATTYPE=CMDTYPE OR NEXTSV(STOPWORD)) THEN
02200 RETURN(SPASS(<IF THISISCON THEN THISWD[2 TO ∞] ELSE VEVAL>))
02300 ELSE IF THISISID AND NEXTSCH(←) THEN comment, Assignment Expression ;
02400 RETURN(VASSIGN(SYMB, THISTYPE, IX, E(IPASS(PASS), STOPWORD)))
02500 ELSE
02600 BEGIN "SIMPLE EXPRESSION"
02700 STRING ANY, comment, result of A OR B OR ...: has value of first TRUE operand;
02800 ALL, comment, result of A AND B AND ...: has value of first FALSE operand;
02900 COMPARE, comment, result of A<B LEQ ...: TRUE if all relations are TRUE;
03000 LEFT, comment, preceding right comparator, saved for another comparison;
03100 BOUNDARY, comment, result of A MAX B MIN... ;
03200 PRODUCT, comment, result of * / MOD & ;
03300 PRIMARY ; comment, <const>|<var>|( <expr> )|<unary><primary>|<primary><substr spec> ;
03400 INTEGER OROP, comment, =0 signals OR waiting for right operand ;
03500 ANDOP, NOTOP, comment, =0 signals AND or NOT operator waiting ;
03600 RELOP, ODDOP, BOUNDOP, ADDOP, MULOP, comment, GEQ 0 signals operator waiting ;
03700 UNARYOP, comment, GEQ 0 signals unary operators waiting ;
03800 U, comment, last of a series of unary operators ;
03900 SS1, comment, starting byte number in substring spec ;
04000 SAVEINF, comment, saved outside value of ∞ ;
04100 SYMPTR, comment, symbol table number of identifier ;
04200 IDTYPE, comment, type field in its NUMBER entry ;
04300 ICOMPARE, ILEFT, IBOUNDARY, ISUM, IPRODUCT, IPRIMARY ; comment, CVD(corresponding string);
04400 BOOLEAN WASONA, WASONO ; comment value of ON before a series of conjuncts or disjuncts ;
04500 DEFINE TRYFAMILY(FAM) = [IF THISTYPE=-FAM THEN IPASS(IX)];
04600 COMMENT Multiple Unary operators ( + , - , ABS , LENGTH , XLENGTH , and ↑ ) are combined
04700 into a single operator by inventing new operators such as
04800 "-ABS" and "ABS LENGTH" ;
04900 DEFINE P = [0], comment, +X ; M = [1], comment, -X ; A = [2], comment, ABS X ;
05000 MA = [3], comment, -ABS X ; C = [4], comment, ↑X ;
05100 L = [5], comment, LENGTH(X) ; ML = [6], comment -LENGTH(X) ;
05200 AL = [7], comment, ABS LENGTH(X) ; MAL = [8], comment, -ABS LENGTH(X) ;
05300 Z = [9], comment, XLENGTH(X) ; MZ = [10], comment -XLENGTH(X) ;
05400 AZ = [11], comment, ABS XLENGTH(X) ; MAZ = [12]; comment, -ABS XLENGTH(X) ; TES 8/14/74 ;
05500 PRELOAD!WITH comment RIGHT OPERATOR
05600 ---------------------------------
05700 LEFT OPERATOR + - ABS ↑ LENGTH XLENGTH
05800 ------------- --- --- --- --- -------- ---------
05900 none; P, M, A, C, L, Z,
06000 comment P ; P, M, A, P, L, Z,
06100 comment M ; M, P, MA, M, ML, MZ,
06200 comment A ; A, A, A, A, AL, AZ,
06300 comment MA ; MA, MA, MA, MA, MAL, MAZ,
06400 comment C ; P, M, A, C, L, Z ;
06500 OWN INTEGER ARRAY COMBINE[-1:4,0:5] ;
06600 COMMENT This is a top-down expression parser, but iteration is used
06700 instead of recursion for rapidity ;
06800
06900 OROP ← ANDOP ← NOTOP ← RELOP ← BOUNDOP ← ADDOP ← MULOP ← -1 ;
07000 WASONO ← ON ;
07100 DO BEGIN "DISJUNCTS" COMMENT Operands of OR ;
07200 WASONA ← ON ;
07300 DO BEGIN "CONJUNCTS" COMMENT Operands of AND ;
07400 WHILE THISTYPE = -NOTQ DO BEGIN NOTOP ← -1 - NOTOP ; PASS END ;
07500 ICOMPARE ← TRUE ;
07600 DO BEGIN "COMPARATORS" COMMENT Operands of < = etc. ;
07700 ODDOP ← TRYFAMILY(ODDQ) ELSE -1 ;
07800 DO BEGIN "BOUNDS" COMMENT Operands of MAX and MIN ;
07900 DO BEGIN "TERMS" COMMENT Operands of + - ≡ ⊗ ;
08000 DO BEGIN "FACTORS" COMMENT Operands of * / MOD & ;
08100 UNARYOP ← -1 ; COMMENT check for Unary Operators ;
08200 WHILE UNARYOP LEQ 3 COMMENT no, P, M, A, or MA left operator ;
08300 AND 0 LEQ (U ← TRYFAMILY(ADDQ) ELSE -1) COMMENT some right operator ;
08400 DO UNARYOP ← COMBINE[UNARYOP, U] ;
08500 comment PRIMARY ;
08600 IF THISISCON THEN BEGIN PRIMARY ← THISWD[2 TO ∞] ; PASS END
08700 ELSE IF THISISID THEN
08800 IF ITSV(STOPWORD) THEN
08900 BEGIN
09000 PRIMARY ← DEFAULT ;
09100 WARN("=","Ill-Formed Expression" & THISWD) ;
09200 END
09300 ELSE IF PROCSTATEMENT THEN PRIMARY ← PROCVALUE
09400 ELSE IF NEXTSCH(<(>) THEN
09500 BEGIN "FUNCALL" TES 8/19/74 ;
09600 IF ITS(DECLARATION) THEN
09700 BEGIN
09800 PASS ; PASS ;
09900 PRIMARY ← CVS(THISTYPE) ; PASS ;
10000 END
10100 ELSE IF ITS(OCTAL) THEN
10200 BEGIN
10300 STRING T ;
10400 PRIMARY ← NULL ; PASS ; PASS ; T ← E(NULL,NULL) ;
10500 WHILE T DO PRIMARY ← PRIMARY & "'" & CVOS(LOP(T)) ;
10600 END
10700 ELSE IF ITS(BEWARE) THEN
10800 BEGIN TES 8/21/74 INVERSE OCTAL ;
10900 STRING T ; INTEGER BRC ;
11000 PRIMARY ← NULL ; PASS ; PASS ; T ← E(NULL,NULL) ;
11100 SETBREAK(LOCAL!TABLE,"'",NULL,"IS") ;
11200 DO BEGIN
11300 SCAN(T, LOCAL!TABLE, BRC) ;
11400 IF BRC THEN PRIMARY ← PRIMARY & CVO(T) ;
11500 END UNTIL NOT BRC ;
11600 END
11700 ELSE IF ITS(SCAN) THEN
11800 BEGIN "SCANCALL"
11900 BOOLEAN ISBRC ;
12000 STRING STR, STOPPERS, IGNORES, OPTIONS ;
12100 INTEGER SYMWAS, IXWAS, TYPEWAS, BRC ;
12200 STOPPERS←IGNORES←OPTIONS←NULL ;
12300 ISBRC ← FALSE ; PASS ; PASS ;
12400 IF THISISID AND NEXTSCH(<,>) THEN
12500 BEGIN COMMENT VARIABLE TO LOP ;
12600 SYMWAS←SYMBOL; IXWAS←IX; TYPEWAS←THISTYPE;
12700 STR ← VEVAL ; PASS ;
12800 END
12900 ELSE BEGIN COMMENT EXPRESSION ;
13000 IXWAS ← -1 ;
13100 STR ← E(NULL, NULL) ;
13200 END ;
13300 IF ITSCH(<,>) THEN
13400 BEGIN COMMENT STOPPERS ;
13500 PASS ; STOPPERS←E(NULL, NULL) ;
13600 IF ITSCH(<,>) THEN
13700 BEGIN COMMENT IGNORES ;
13800 PASS ; IGNORES ← E(NULL,NULL) ;
13900 IF ITSCH(<,>) THEN
14000 BEGIN COMMENT OPTIONS ;
14100 PASS ; OPTIONS ← E(NULL,NULL) ;
14200 IF ITSCH(<,>) THEN
14300 BEGIN COMMENT BRC VARIABLE ;
14400 PASS ;
14500 IF THISISID AND NEXTSCH(<)>) THEN
14600 ISBRC←TRUE
14700 ELSE WARN(NULL, "SCAN's BRC must be variable name") ;
14800 END ;
14900 END ;
15000 END ;
15100 END ;
15200 SETBREAK(LOCAL!TABLE, STOPPERS, IGNORES,
15300 IF FULSTR(OPTIONS) THEN OPTIONS ELSE "IR") ;
15400 PRIMARY ← SCAN(STR, LOCAL!TABLE, BRC) ;
15500 BREAKSET(LOCAL!TABLE, NULL, "O") ; TES 10/1/74 ;
15600 IF ISBRC THEN
15700 BEGIN
15800 VASSIGN(SYMBOL, THISTYPE, IX, IF BRC=0 THEN NULL ELSE BRC) ;
15900 PASS ;
16000 END ;
16100 IF IXWAS NEQ -1 THEN VASSIGN(SYMWAS, TYPEWAS, IXWAS, STR) ;
16200 END "SCANCALL"
16300 ELSE BEGIN
16400 WARN(NULL,"Unknown Function " & THISWD) ;
16500 PASS ; PASS ; PRIMARY ← DEFAULT ;
16600 WHILE NOT ITSCH(<)>) DO
16700 IF ITSCH(<,>) THEN PASS
16800 ELSE E(NULL,NULL) ;
16900 END ;
17000 IF ITSCH(<)>) THEN PASS
17100 ELSE WARN(NULL, <"Missing ) after function call">) ;
17200 END "FUNCALL"
17300 ELSE BEGIN PRIMARY ← VEVAL ; PASS END
17400 ELSE IF ITSCH(<(>) THEN
17500 BEGIN "( <EXPR> )"
17600 PASS ; PRIMARY ← E(DEFAULT, 0) ;
17700 IF ITSCH(<)>) THEN PASS ELSE WARN("=",<"Missed )">) ;
17800 END "( <EXPR> )"
17900 ELSE BEGIN WARN("=","Ill-Formed expression" & THISWD) ; PRIMARY ← DEFAULT END ;
18000 WHILE THISTYPE=-BROKQ DO COMMENT Substring Specifications ;
18100 BEGIN "SUBSPEC"
18200 PASS ; SAVEINF ← INF ; INF ← LENGTH(PRIMARY) ;
18300 SS1 ← CVD(E("1", IF NEXTS(TO) THEN "TO" ELSE "FOR")) ;
18400 IF ITS(TO) THEN BEGIN PASS ; PRIMARY←PRIMARY[SS1 TO CVD(E("0",0))] END
18500 ELSE IF ITS(FOR) THEN BEGIN PASS ; PRIMARY←PRIMARY[SS1 FOR CVD(E("1",0))] END
18600 ELSE PRIMARY ← PRIMARY[SS1 FOR 1] ;
18700 SAIL!SKIP! ← !SKIP! ;
18800 IF ITSCH(<]>) THEN PASS ELSE WARN("=",<"Missed ] in substring spec " & THISWD>) ;
18900 INF ← SAVEINF ;
19000 END "SUBSPEC" ;
19100 IF UNARYOP LEQ 3 THEN COMMENT both int & str versions maintained when needed ;
19200 IPRIMARY ← IF PRIMARY="'" THEN CVO(PRIMARY[2 TO ∞]) TES 8/19/74 ;
19300 ELSE CVD(PRIMARY) ;
19400 IF UNARYOP GEQ 0 THEN IF UNARYOP=C THEN IPRIMARY←CVD(PRIMARY←CAPITALIZE(PRIMARY))
19500 ELSE PRIMARY ← CVS(IPRIMARY ← CASE UNARYOP OF (IPRIMARY, -IPRIMARY,
19600 ABS IPRIMARY, -ABS IPRIMARY, 0, LENGTH(PRIMARY), -LENGTH(PRIMARY),
19700 ABS LENGTH(PRIMARY), -ABS LENGTH(PRIMARY),
19800 XLENGTH(PRIMARY), -XLENGTH(PRIMARY),
19900 ABS XLENGTH(PRIMARY), -ABS XLENGTH(PRIMARY) ) ) ; TES 8/14/74;
20000 IF MULOP<0 THEN BEGIN PRODUCT ← PRIMARY ; IPRODUCT ← IPRIMARY END
20100 ELSE IF MULOP = 3 THEN IPRODUCT ← CVD(PRODUCT ← PRODUCT & PRIMARY)
20200 ELSE PRODUCT ← CVS(IPRODUCT ← IF IPRIMARY=0 OR NOT ON THEN 0 ELSE CASE MULOP OF
20300 (IPRODUCT*IPRIMARY, IPRODUCT DIV IPRIMARY, IPRODUCT MOD IPRIMARY) ) ;
20400 MULOP ← TRYFAMILY(MULQ) ELSE -1 ;
20500 END "FACTORS" UNTIL MULOP < 0 ;
20600
20700 ISUM ← CASE ADDOP+2 OF (IPRODUCT, IPRODUCT, ISUM + IPRODUCT,
20800 ISUM - IPRODUCT, ISUM ≡ IPRODUCT, ISUM ⊗ IPRODUCT) ;
20900 ADDOP ← TRYFAMILY(ADDQ) ELSE IF ADDOP<0 THEN -1 ELSE -2 ;
21000 END "TERMS" UNTIL ADDOP < 0 ;
21100
21200 IBOUNDARY ← CASE BOUNDOP+2 OF (ISUM, ISUM, IBOUNDARY MAX ISUM, IBOUNDARY MIN ISUM) ;
21300 BOUNDOP ← TRYFAMILY(BOUNDQ) ELSE IF ADDOP=-1 AND BOUNDOP<0 THEN -1 ELSE -2 ;
21400 END "BOUNDS" UNTIL BOUNDOP < 0 ;
21500 BOUNDARY ← IF BOUNDOP = -1 THEN PRODUCT COMMENT, hasn't changed since then; ELSE CVS(IBOUNDARY) ;
21600 IF ODDOP GEQ 0 THEN BOUNDARY←CVS(IBOUNDARY←(IBOUNDARY MOD 2)=ODDOP);
21700 IF ICOMPARE THEN CASE RELOP+2 OF BEGIN comment SAIL Bug precludes case expression with relationals;
21800 BEGIN END ; BEGIN END ; ICOMPARE←ILEFT<IBOUNDARY; ICOMPARE←ILEFT>IBOUNDARY; ICOMPARE ←
21900 EQU(LEFT,BOUNDARY); ICOMPARE←ILEFT LEQ IBOUNDARY; ICOMPARE←ILEFT GEQ IBOUNDARY;
22000 ICOMPARE← NOT EQU(LEFT,BOUNDARY) END ;
22100 RELOP ← TRYFAMILY(RELQ) ELSE IF RELOP < 0 THEN -1 ELSE -2 ;
22200 LEFT ← BOUNDARY ; ILEFT ← IBOUNDARY ;
22300 END "COMPARATORS" UNTIL RELOP < 0 ;
22400 COMPARE ← IF RELOP=-1 THEN BOUNDARY ELSE CVS(ICOMPARE) ;
22500 IF NOTOP = 0 THEN COMPARE ← IF TRUESTR(COMPARE) THEN "0" ELSE "-1" ;
22600 NOTOP ← -1 ;
22700 IF ANDOP < 0 OR TRUESTR(ALL) THEN IF FALSTR(ALL ← COMPARE) THEN ON ← FALSE ;
22800 ANDOP ← TRYFAMILY(ANDQ) ELSE -1 ; ALL ← ALL ; comment SAIL bug -- force it to store;
22900 END "CONJUNCTS" UNTIL ANDOP < 0 ;
23000 ON ← WASONA ;
23100 IF OROP < 0 OR FALSTR(ANY) THEN IF TRUESTR(ANY ← ALL) THEN ON ← FALSE ;
23200 OROP ← TRYFAMILY(ORQ) ELSE -1 ; ANY ← ANY ; comment SAIL bug -- force it to store ;
23300 END "DISJUNCTS" UNTIL OROP < 0 ;
23400 ON ← WASONO ;
23500 RETURN(DUMMYSTR ← ANY) ; comment, DUMMYSTR due to SAIL RECURSIVE STRING PROCEDURE bug (see DCS);
23600 END "SIMPLE EXPRESSION" ;
00100 PRIVATE BOOLEAN SIMPLE PROCEDURE EMPTYCHUNK ;$"#
00200 RETURN(IF ITSCH(;) THEN IPASS(TRUE) ELSE FALSE) ;
00100 PUBLIC SIMPLE PROCEDURE MANUSCRIPT ;$"#
00200 BEGIN
00300 BOOLEAN VALID ;
00400 PASS ; COMMENT 9/9/74 TES ;
00500 VALID ← TRUE ;
00600 DO VALID ← CHUNK(VALID) UNTIL LAST < 1 ;
00700 IF NOT NEXTS(7!MANUSCRIPT) THEN WARN("=","Brackets don't pair up!!!!!!!!!") ;
00800 FINPORTION ; IF BLNMS=0 THEN ENDBEGIN ELSE IF BLNMS>0 THEN
00900 WARN("=",CVS(BLNMS) & " Extra BEGINs and STARTs") ;
01000 END "MANUSCRIPT" ;
00100 PRIVATE BOOLEAN SIMPLE PROCEDURE NONSENSE(BOOLEAN VALID) ;$"#
00200 BEGIN
00300 IF VALID THEN WARN("=","Can't make sense out of: "&SOMEINPUT) ;
00400 PASS ; RETURN(FALSE) ;
00500 END "NONSENSE" ;
00100 PUBLIC RECURSIVE BOOLEAN PROCEDURE STATEMENT ;$"#
00200 BEGIN "STATEMENT"
00300 INTEGER LVL, RLVL ; BOOLEAN VALID ;
00400 LVL ← BLNMS ; RLVL ← DEEPREPEATS ; TES 8/14/74 ;
00500 DO VALID ← CHUNK(VALID) UNTIL BLNMS LEQ LVL ;
00600 RETURN(RLVL > DEEPREPEATS) ; TES 8/14/74 ;
00700 END "STATEMENT" ;
00100 FINISHED
00200
00300 ENDOF("ALGOL")